;;; red-black-tree-set.ss   --  Jens Axel Søgaard  --  3rd nov 2003

;;; SETS IMPLEMENTED AS RED-BLACK TREES.
#lang scheme
;(module red-black-tree-set scheme

; TODO? change background tree (for example, flush it to disk)

; TODO: mutable updates
; TODO: rbslice, 2 * iterator
; TODO: ssrslice ?

; TODO: remove-range
; TODO: insert-range
; TODO: replace-range
; TODO: rb-subtree

(provide rb rb-1 
         list->rb 
         ; TODO: sorted-list->rb
         rb-get=  rb-get=* 
         rb-get>  rb-get>*
         rb-get<  rb-get<*
         rb-get>= rb-get>=* 
         rb-get<= rb-get<=* 
         rb-first rb-last rb-ref
         rb-update rb-replace rb-insert
         rb-remove
         ; TODO: rb-update!
         ; TODO: rb-remove!
         rb-for-each
         rb->iter
         rb-fold
         rb-fold-right
         rb->list
         rb-map 
         rb-map!
         rb-every
         rb-any
         rb-depth
         rb-length
         rb-subset?
         rb=?
         rb-union rb-substract
         
         rb-geti= ; TODO: rb-geti< rb-geti> rb-geti<= rb-geti>=
         rb-refi
         rb-firsti rb-lasti  
         rbi-next   rbi-prev   ; TODO: rbi-move
         rbi=?      rbi-value  rbi-n
         )

(require ;(all-except (lib "list.ss") empty empty? remove remove* filter)
  (lib "match.ss")
  (lib "1.ss" "srfi")
  (lib "27.ss" "srfi")
  (lib "67.ss" "srfi")
  (lib "43.ss" "srfi")
  (lib "71.ss" "srfi")
  "iter.ss"
  "tidbits.ss"
  )


(define (rb-length t)
  (match t
    ['() 0]
    ; not saved length
    ;    [(vector _ l _ r #f) (+ 1 (rb-length l) (rb-length r))]
    ; lazy length, for faster inserts
    [#(_ l _ r 0)  (let ([z (+ 1 (rb-length l) (rb-length r))])
                     (vector-set! t 4 z) 
                     z)]
    [#(_ _ _ _ i)  i]))


; Constructor shorthands
; eager length 
(define (   B l v r [i (+ 1 (rb-length l) (rb-length r))]) (vector 'B l v r i))
(define (   R l v r [i (+ 1 (rb-length l) (rb-length r))]) (vector 'R l v r i))
(define (RB c l v r [i (+ 1 (rb-length l) (rb-length r))]) (vector  c l v r i))
; lazy length
;(define (   B l v r [i 0]) (vector 'B l v r i))
;(define (   R l v r [i 0]) (vector 'R l v r i))
;(define (RB c l v r [i 0]) (vector  c l v r i))

; for debugging
(define (rb->sexp t)
  (match t
    ['() '()]
    [(vector color l x r i) (list i color (rb->sexp l) x (rb->sexp r))]))

(define (rb-check s)
  (match s
    ['()     0]
    ; (1) a red node has no red son,
    [(or #('R #('R _ _ _ _) _ _ _)
         #('R _ _ #('R _ _ _ _) _))  (error "Red node with red parent" s)]
    ; (2) any path from the root to a leaf has the same number of black nodes
    [#('B l _ r _)           (let ([height-left  (rb-check l)]
                                   [height-right (rb-check r)])
                               (if (not (= height-left height-right))
                                   (error)
                                   (+ height-left 1)))]
    [#('R l _ r _)           (let ([height-left  (rb-check l)]
                                   [height-right (rb-check r)])
                               (if (not (= height-left height-right))
                                   (error)
                                   height-left))]))

(define (rb-1 x)
  (B '() x '() 1))

(define (list->rb cmp xs)
  (foldl (lambda (x s) (rb-insert cmp x s)) '() xs))

(define (rb cmp . xs)
  (list->rb cmp xs))


; get exact
; (v -> v -> integer) -> v -> rb -> (v integer)
(define (rb-get=* cmp x s [default #f])
  (let loop ([s s])
    (match s
      ['()           (values default -1)]
      [#(_ l v r _)  (if3 (cmp x v)
                          (loop l)
                          (values v (rb-length l))
                          (let-values ([(y i) (loop r)])
                            (values y (+ i 1 (rb-length l)))))])))

(define (rb-get>* less x s [default #f])
  ;  (define (less a b) (= -1 (cmp a b)))
  (let loop ([s s])
    (match s
      ['()           (values default -1)]
      [#(_ l v r _)  (if (less x v)
                         (let-values ([(y i) (loop l)])
                           (if (eq? default y) 
                               (values v (rb-length l))
                               (values y i)))
                         (let-values ([(y i) (loop r)])
                           (values y (+ i 1 (rb-length l)))))])))

(define (rb-get<* less x s [default #f])
  ;  (define (less a b) (= -1 (cmp a b)))
  (let loop ([s s])
    (match s
      ['()                 (values default -1)]
      [#(_ l v r _)  (if (not (less v x))
                         (loop l)
                         (let-values ([(y i) (loop r)])
                           (if (eq? default y) 
                               (values v (rb-length l))
                               (values y (+ i 1 (rb-length l))))))])))

(define (rb-get>=* cmp x s [default #f])
  (let loop ([s s])
    (match s
      ['()                 (values default -1)]
      [#(_ l v r _)  (if3 (cmp x v)
                          (let-values ([(y i) (loop l)])
                            (if (eq? default y) 
                                (values v (rb-length l))
                                (values y i)))
                          (values v (rb-length l))
                          (let-values ([(y i) (loop r)])
                            (values y (+ i 1 (rb-length l)))))])))

(define (rb-get<=* cmp x s [default #f])
  (let loop ([s s])
    (match s
      ['()                 (values default -1)]
      [#(_ l v r _)  (if3 (cmp x v)
                          (loop l)
                          (values v (rb-length l))
                          (let-values ([(y i) (loop r)])
                            (if (eq? default y) 
                                (values v (rb-length l))
                                (values y (+ i 1 (rb-length l))))))])))


(define (rb-ref s idx)
  (let loop ([idx1 idx][s1 s])
    (match s1
      ['()           (error (format "ref: index ~a is out of range [0;~a]" idx (sub1 (rb-length s))))]
      [#(_ l v r _)  (let ([il (rb-length l)])
                       (if3 (integer-compare idx1 il)
                            (loop idx1 l)
                            v
                            (loop (- idx1 il 1) r)))])))


;(define (rb-get=  cmp x s [default #f])  (values-first (rb-get=*  cmp x s default)))
(define (rb-get= cmp x s [default #f])
  (let loop ([s s])
    (match s
      ['()           default]
      [#(_ l v r _)  (if3 (cmp x v)
                          (loop l)
                          v
                          (loop r))])))

;(define (rb-get>  cmp x s [default #f])  (values-first (rb-get>*  cmp x s default)))
(define (rb-get> less x s [default #f])
  ;  (define (less a b) (= -1 (cmp a b)))
  (let loop ([s s])
    (match s
      ['()                 default]
      [#(_ l v r _)  (if (less x v)
                         (let ([y (loop l)])
                           (if (eq? default y) v y))
                         (loop r))])))

;(define (rb-get<  cmp x s [default #f])  (values-first (rb-get<*  cmp x s default)))
(define (rb-get< less x s [default #f])
  ;  (define (less a b) (= -1 (cmp a b)))
  (let loop ([s s])
    (match s
      ['()                 default]
      [#(_ l v r _)  (if (not (less v x)) ; WARNING: reversed argument order
                         (loop l)
                         (let ([y (loop r)])
                           (if (eq? default y) v y)))])))

;(define (rb-get>= cmp x s [default #f])  (values-first (rb-get>=* cmp x s default)))
(define (rb-get>= cmp x s [default #f])
  (let loop ([s s])
    (match s
      ['()                 default]
      [#(_ l v r _)  (if3 (cmp x v)
                          (let ([y (loop l)])
                            (if (eq? default y) v y))
                          v
                          (loop r))])))

;(define (rb-get<= cmp x s [default #f])  (values-first (rb-get<=* cmp x s default)))
(define (rb-get<= cmp x s [default #f])
  (let loop ([s s])
    (match s
      ['()                 default]
      [#(_ l v r _)  (if3 (cmp x v)
                          (loop l)
                          v
                          (let ([y (loop r)])
                            (if (eq? default y) v y)))])))


;; BALANCING
(define (lbalance l v r)
  (match l
    [#('R #('R a x b i) y c _)  (R (B a x b i) y (B c v r))]
    [#('R a x #('R b y c _) _)  (R (B a x b) y (B c v r))]
    [_                          (B l v r)]))

(define (rbalance l v r)
  (match r
    [#('R #('R b y c _) z d _)  (R (B l v b) y (B c z d))]
    [#('R b y #('R c z d i) _)  (R (B l v b) y (B c z d i))]
    [_                          (B l v r)]))


;; INSERTION
; immutable update
; mutator :: (a | #f) -> a
; TODO: check if mutator returns false
(define (rb-update cmp x mutator s)
  (define (ins s)
    (match s
      ['()  (values (R '() (mutator #f) '())  #f  'inserted )]
      [#(c l v r i) 
       (if3 (cmp x v)
            (let-values ([(l1 oldv status) (ins l)])
              (values (case status
                        [(the-same) s]
                        [else (case c
                                [(R) (R l1 v r)]
                                [(B) (lbalance l1 v r)])]) oldv status))
            (let ([new-v (mutator v)])
              (if (eq? new-v v) ; nothing realy changed
                  (values s v 'the-same)
                  (values (R l new-v r i) v 'replaced)))
            (let-values ([(r1 oldv status) (ins r)])
              (values (case status
                        [(the-same) s]
                        [else (case c
                                [(R) (R l v r1)]
                                [(B) (rbalance l v r1)])]) oldv status)))]))
  (define (color-the-root-black s)
    (match s
      [#('B _ _ _ _)  s]
      [#('R a y b i)  (B a y b i)]
      ['()                 (error)]))
  (let-values ([(s1 oldv status) (ins s)])
    (case status
      [(the-same) (values s1 oldv status)]
      [(replaced) (values (color-the-root-black s1) oldv status)]
      [(inserted) (values (color-the-root-black s1) oldv status)])))

(define (rb-insert  cmp x s)
  (values-first (rb-update cmp x (lambda(v) (or v x)) s)))

(define (rb-replace cmp x s)  
  (values-first (rb-update cmp x (const x) s)))


;  (* [unbalanced_left] repares invariant (2) when the black height of the
;     left son exceeds (by 1) the black height of the right son *)
(define (unbalanced-left s)
  (match s
    [#('R #('B t1 x1 t2               _) x3 t4 _)  (values          (lbalance (R t1 x1 t2) x3 t4)  #f)]
    [#('B #('B t1 x1 t2               _) x3 t4 _)  (values          (lbalance (R t1 x1 t2) x3 t4)  #t)]
    [#('B #('R t1 x1 #('B t2 x2 t3 _) _) x3 t4 _)  (values (B t1 x1 (lbalance (R t2 x2 t3) x3 t4)) #f)]
    [_ (error)]))

;  (* [unbalanced_right] repares invariant (2) when the black height of the
;     right son exceeds (by 1) the black height of the left son *)
(define (unbalanced-right s)
  (match s
    [#('R t1 x1 #('B t2               x3 t4 _) _)  (values    (rbalance t1 x1 (R t2 x3 t4))        #f)]
    [#('B t1 x1 #('B t2               x3 t4 _) _)  (values    (rbalance t1 x1 (R t2 x3 t4))        #t)]
    [#('B t1 x1 #('R #('B t2 x2 t3 _) x3 t4 _) _)  (values (B (rbalance t1 x1 (R t2 x2 t3)) x3 t4) #f)]
    [_ (error)]))


(define (blackify s)
  (match s
    [#('R l x r i)  (values (B l x r i) #f)]
    [_              (values s #t)]))


;  (* [remove_min s = (s',m,b)] extracts the minimum [m] of [s], [s'] being the
;     resulting set, and indicates with [b] whether the black height has
;     decreased *)
(define (remove-min s)
  (match s
    ['()                    (error "remove-min: Called on empty set")]
    ;  minimum is reached
    [#('B '() x '() _)            (values '() x #t)]
    [#('B '() x #('R l y r _) _)  (values (B l y r) x #f)]
    [#('B '() _ #('B _ _ _ _) _)  (error)]
    [#('R '() x r _)              (values r x #f)]
    ;  minimum is recursively extracted from [l]
    [#( c l x r _)  (let-values ([(l1 m d) (remove-min l)])
                      (let ([t (RB c l1 x r)])
                        (if d
                            (let-values ([(t d1) (unbalanced-right t)])
                              (values t m d1))
                            (values t m #f))))]))

;  (* [remove_aux x s = (s',b)] removes [x] from [s] and indicates with [b]
;     whether the black height has decreased *)
(define (rb-remove cmp x s)
  (define (remove-aux s)
    (match s
      ['()           (values '() #f)]
      [#(c l y r _)  (if3 (cmp x y)
                          (let-values ([(l1 d) (remove-aux l)])
                            (let ([t (RB c l1 y r)])
                              (if d
                                  (unbalanced-right t)
                                  (values t #f))))
                          (match r
                            ['() (case c
                                   [(B)  (blackify l)] 
                                   [(R)  (values l #f)])]
                            [_   (let-values ([(r1 m d) (remove-min r)])
                                   (let ([t (RB c l m r1)])
                                     (if d
                                         (unbalanced-left t)
                                         (values t #f))))])
                          (let-values ([(r1 d) (remove-aux r)])
                            (let ([t (RB c l y r1)])
                              (if d
                                  (unbalanced-left t)
                                  (values t #f)))))]))
  (values-first (remove-aux s)))

(define (rb-for-each f s)
  (let loop ([s s])
    (match s
      ['()          (void)]
      [#(_ l v r _) (loop l)
                    (f v)
                    (loop r)])))


(define (rb-fold f acc s)
  (match s 
    ['()          acc]
    [#(_ l v r _) (rb-fold f (f v (rb-fold f acc l)) r)]))

(define (rb-fold-right f acc s)
  (match s 
    ['()          acc]
    [#(_ l v r _) (rb-fold-right f (f v (rb-fold-right f acc r)) l)]))

(define (rb->list s)
  (rb-fold-right cons '() s))

; f must preserve element order
(define (rb-map f s)
  (match s 
    ['()         '()]
    [#(c l v r i) (RB c (rb-map f l) (f v) (rb-map f r) i)]))

(define (rb-map! f s)
  (match s 
    ['()         '()]
    [#(c l v r i) (rb-map! f l)
                  (vector-set! s 2 (f v))
                  (rb-map! f r)])
  (void))

;  (*s Other functions *)

(define (rb-every pred s)
  (match s
    ['()          #t]
    [#(_ l v r _)  (and (pred v) (rb-every pred l) (rb-every pred r))]))

(define (rb-any pred s)
  (match s
    ['()          #f]
    [#(_ l v r _)  (or (pred v) (rb-any pred l) (rb-any pred r))]))

;(define (rb-filter cmp p s)
;  (define (filt acc s)
;    (match s
;      ['()           acc]
;      [(vector'R l v r _)  (filt (filt (if (p v) (rb-insert cmp v acc) acc) l) r)]))
;  (filt '() s))

(define (rb-depth s)
  (match s
    ['()           1]
    [#(_ l _ r _)  (+ 1 (max (rb-depth l) (rb-depth r)))]))

; minimum
(define (rb-first s)
  (match s
    ['()             (error "min: No minimum element in an empty set.")]
    [#(_ '() v _ _)  v]
    [#(_  l  _ _ _)  (rb-first l)]))

; maximum
(define (rb-last s)
  (match s
    ['()             (error "max: No maximum element in an empty set.")]
    [#(_ _ v '() _)  v]
    [#(_ _ _   r _)  (rb-last r)]))


; is s1 subset of s2
(define (rb-subset? cmp s1 s2)
  (cond
    [(null? s1) #t]
    [(null? s2) #f]
    [else (match-let ([#(_ l1 v1 r1 _) s1]
                      [#(_ l2 v2 r2 _) s2])
            (if3 (cmp v1 v2)
                 ; TODO? v1<v2 should be enough to return false
                 (and (rb-subset? cmp (B l1 v1 '()) l2)
                      (rb-subset? cmp r1 s2))
                 (and (rb-subset? cmp l1 l2)
                      (rb-subset? cmp r1 r2))
                 (and (rb-subset? cmp (B '() v1 r1) r2)
                      (rb-subset? cmp l1 s2))))]))

; equal? is element comparator, (=? cmp)
(define (rb=? eq s1 s2)
  (cond
    [(and (null? s1) (null? s2)) #t]
    [(or  (null? s1) (null? s2)) #f]
    [else (match-let ([#(_ l1 v1 r1 _) s1]
                      [#(_ l2 v2 r2 _) s2])
            (and (eq v1 v2)
                 (= (rb-length s1) (rb-length s2))
                 (rb=? eq l1 l2)
                 (rb=? eq r1 r2)))]))

; set operations
; not optimal
(define (rb-union cmp s1 s2)
  (rb-fold (lambda(x s) (rb-insert cmp x s)) s1 s2))

(define (rb-substract cmp s1 s2)
  (rb-fold (lambda(x s) (rb-remove cmp x s)) s1 s2))


; ITERATORS

; rb -> a -> rbi
;(define (rb-geti= cmp x s)
;(define (rb-geti< cmp x s)
;(define (rb-geti> cmp x s)
;(define (rb-geti<= cmp x s)
;(define (rb-geti>= cmp x s)
(define (rb-geti= cmp x s)
  (let loop ([s s] [ii '()])
    (match s
      ['()            #f]
      [#(_ l v r _)  (if3 (cmp x v)
                          (loop l (cons s ii))
                          (cons s ii)
                          (loop r (cons s ii)))])))

; rb -> number -> rbi
;(define (rb-refi s)
(define (rb-refi s idx)
  (let loop ([idx1 idx][s1 s] [ii '()])
    (match s1
      ['()           (error (format "ref: index ~a is out of range [0;~a]" idx (sub1 (rb-length s))))]
      [#(_ l v r _)  (let ([il (rb-length l)])
                       (if3 (integer-compare idx1 il)
                            (loop idx1 l (cons s1 ii))
                            (cons s1 ii)
                            (loop (- idx1 il 1) r (cons s1 ii))
                            ))])))

; minimum
(define (rb-firsti s)
  (let loop ([s s][ii '()])
    (match s
      ['()             (error "rb-firsti: empty set")]
      [#(_ '() v _ _)  (cons s ii)]
      [#(_  l  _ _ _)  (loop l (cons s ii))])))

; maximum
(define (rb-lasti s)
  (let loop ([s s][ii '()])
    (match s
      ['()                   (error "rb-lasti: empty set")]
      [#(_ _ v '() _)  (cons s ii)]
      [#(_ _ _   r _)  (loop r (cons s ii))])))

(define (rbi-next ii) ; TODO: [n 1]
  (match (car ii)
    [#(_ _ _ '() _) ; go up
     (let loop ([ii ii])
       (if (null? (cdr ii))
           #f ; finish
           (match-let* ([tup (second ii)]
                        [#(_ l _ r _) tup])
             (cond [(eq? l (car ii)) (cdr ii)]
                   [(eq? r (car ii)) (loop (cdr ii)) ]))))]
    [#(_ _ _ r _) ; go down
     ; choose left branch until the bottom
     (let loop ([ii (cons r ii)])
       (match (car ii)
         [#(_ '() _ _ _) ii]
         [#(_   l _ _ _) (loop (cons l ii))]))]))


(define (rbi-prev ii) ; TODO: [n 1]
  (match (car ii)
    [#(_ '() _ _ _) ; go up
     (let loop ([ii ii])
       (if (null? (cdr ii))
           #f ; finish
           (match-let* ([tup (second ii)]
                        [#(_ l _ r _) tup])
             (cond [(eq? r (car ii)) (cdr ii)]
                   [(eq? l (car ii)) (loop (cdr ii)) ]))))]
    [#(_ l _ _ _) ; go down
     ; choose right branch until the bottom
     (let loop ([ii (cons l ii)])
       (match (car ii)
         [#(_ _ _ '() _) ii]
         [#(_ _ _ r   _) (loop (cons r ii))]))]))


; rbi -> number -> rbi
;(define (rbi-move ii delta)


(define (rbi=? i1 i2)
  ;  (when (eq? (car i1) (car i2))
  ;    (=! (length i1) (length i2)))
  (eq? (car i1) (car i2)))

(define (rbi-value ii)
  (match-let ([#(_ _ v _ _) (car ii)])
    v))

; cursor -> number
(define (rbi-n ii)
  (match-let ([#(_ l _ _ _) (car ii)])
    (let loop ([sum (rb-length l)] [ii ii])
      (if (null? (cdr ii))
          sum
          (match-let ([tprev (first ii)]
                      [#(_ l _ r _) (second ii)])
            (cond [(eq? tprev l) (loop sum (cdr ii))]
                  [(eq? tprev r) (loop (+ sum 1 (rb-length l)) (cdr ii))]
                  [else (error)]))))))


(define (rb->iter s)
  (make-iter (rb-firsti s)
             not ;(lambda(i) (eq? i #f))
             rbi-next
             rbi-value))

(define (rb->iter/backward s)
  (make-iter (rb-lasti s)
             not ;(lambda(i) (eq? i #f))
             rbi-prev
             rbi-value))

(define (rb->iter/slow-test-variant s)
  (define len (rb-length s))
  (make-iter 0
             (lambda(i) (= i len))
             add1
             (lambda(i) (rb-ref s i))))


; +TEST
;=======================================================================
;  (require "set-signature.ss")
;  (provide-set)
#||#
(require "tidbits.ss" "bytes.ss" "test.ss")
(define s '())
(define (cmp a b)
  (define (->num x)
    (cond [(bytes? x) (bytes->number x)]
          [(string? x) (string->number x)]
          [(inexact? x) (inexact->exact x)]
          [else x]))
  (integer-compare (->num a) (->num b)))

(set! s (rb-insert cmp #"1111" s))
(set! s (rb-insert cmp #"2222" s))
(set! s (rb-insert cmp #"3333" s))
(set! s (rb-insert cmp #"4444" s))
(set! s (rb-insert cmp #"5555" s))
(set! s (rb-insert cmp #"6666" s))

(equal! (build-list (rb-length s) (lambda(i) (rbi-n (rb-refi s i))))
        '(0 1 2 3 4 5))

(equal! (build-list (rb-length s) (lambda(i) (rbi-value (rb-refi s i))))
        (build-list (rb-length s) (lambda(i) (rb-ref s i)))
        '(#"1111" #"2222" #"3333" #"4444" #"5555" #"6666"))

(equal! (rb->list (rb-insert cmp 4444 s))
        '(#"1111" #"2222" #"3333" #"4444" #"5555" #"6666"))
(equal! (rb->list (rb-replace cmp 4444 s))
        '(#"1111" #"2222" #"3333" 4444 #"5555" #"6666"))
(equal! (rb->list (rb-insert cmp 5000 s))
        (rb->list (rb-replace cmp 5000 s))
        '(#"1111" #"2222" #"3333" #"4444" 5000 #"5555" #"6666"))

(define rb-1-5 (rb integer-compare 1 2 3 4 5))
(define rb-1-10 (rb integer-compare 1 2 3 4 5 6 7 8 9 10))
(true!  (rb-subset? integer-compare rb-1-5  rb-1-5 ))
(true!  (rb-subset? integer-compare rb-1-5  rb-1-10))
(false! (rb-subset? integer-compare rb-1-10 rb-1-5 ))
(true!  (rb-subset? integer-compare rb-1-10 rb-1-10))

(true! (rbi=? (rb-refi s 0) (rb-geti= cmp 1111 s)))
(true! (rbi=? (rb-refi s 1) (rb-geti= cmp 2222 s)))
(true! (rbi=? (rb-refi s 2) (rb-geti= cmp 3333 s)))
(true! (rbi=? (rb-refi s 3) (rb-geti= cmp 4444 s)))
(true! (rbi=? (rb-refi s 4) (rb-geti= cmp 5555 s)))
(true! (rbi=? (rb-refi s 5) (rb-geti= cmp 6666 s)))

(true!  (rbi=? (rbi-next (rb-refi s 0)) (rb-refi s 1) ))
(true!  (rbi=? (rbi-next (rb-refi s 1)) (rb-refi s 2) ))
(true!  (rbi=? (rbi-next (rb-refi s 2)) (rb-refi s 3) ))
(true!  (rbi=? (rbi-next (rb-refi s 3)) (rb-refi s 4) ))
(true!  (rbi=? (rbi-next (rb-refi s 4)) (rb-refi s 5) ))
(false! (rbi-next (rb-refi s 5)))

;(exit)
;(depth s)
;(->sexp s)
;(exit)

;(eq-hash-code s)
;(insert* cmp 3333 s)
(equal! (values-first (rb-get=* cmp 1000 s)) #f)           (equal! (rb-get= cmp 1000 s) #f)
(equal! (values->list (rb-get=* cmp 1111 s)) '(#"1111" 0)) (equal! (rb-get= cmp 1111 s) #"1111")
(equal! (values-first (rb-get=* cmp 4000 s)) #f)           (equal! (rb-get= cmp 4000 s) #f)
(equal! (values->list (rb-get=* cmp 4444 s)) '(#"4444" 3)) (equal! (rb-get= cmp 4444 s) #"4444")
(equal! (values-first (rb-get=* cmp 4445 s)) #f)           (equal! (rb-get= cmp 4445 s) #f)
(equal! (values->list (rb-get=* cmp 6666 s)) '(#"6666" 5)) (equal! (rb-get= cmp 6666 s) #"6666")
(equal! (values-first (rb-get=* cmp 9999 s)) #f)           (equal! (rb-get= cmp 9999 s) #f)

(equal! (values->list (rb-get>=* cmp 1000 s)) '(#"1111" 0)) (equal! (rb-get>= cmp 1000 s) #"1111")
(equal! (values->list (rb-get>=* cmp 1111 s)) '(#"1111" 0)) (equal! (rb-get>= cmp 1111 s) #"1111")
(equal! (values->list (rb-get>=* cmp 4000 s)) '(#"4444" 3)) (equal! (rb-get>= cmp 4000 s) #"4444")
(equal! (values->list (rb-get>=* cmp 4444 s)) '(#"4444" 3)) (equal! (rb-get>= cmp 4444 s) #"4444")
(equal! (values->list (rb-get>=* cmp 4445 s)) '(#"5555" 4)) (equal! (rb-get>= cmp 4445 s) #"5555")
(equal! (values->list (rb-get>=* cmp 6666 s)) '(#"6666" 5)) (equal! (rb-get>= cmp 6666 s) #"6666")
(equal! (values-first (rb-get>=* cmp 9999 s)) #f)           (equal! (rb-get>= cmp 9999 s) #f)

(equal! (values->list (rb-get>*  (<? cmp) 1000 s)) '(#"1111" 0)) (equal! (rb-get>  (<? cmp) 1000 s) #"1111")
(equal! (values->list (rb-get>*  (<? cmp) 1111 s)) '(#"2222" 1)) (equal! (rb-get>  (<? cmp) 1111 s) #"2222")
(equal! (values->list (rb-get>*  (<? cmp) 4000 s)) '(#"4444" 3)) (equal! (rb-get>  (<? cmp) 4000 s) #"4444")
(equal! (values->list (rb-get>*  (<? cmp) 4444 s)) '(#"5555" 4)) (equal! (rb-get>  (<? cmp) 4444 s) #"5555")
(equal! (values->list (rb-get>*  (<? cmp) 4445 s)) '(#"5555" 4)) (equal! (rb-get>  (<? cmp) 4445 s) #"5555")
(equal! (values-first (rb-get>*  (<? cmp) 6666 s)) #f)           (equal! (rb-get>  (<? cmp) 6666 s) #f)
(equal! (values-first (rb-get>*  (<? cmp) 9999 s)) #f)           (equal! (rb-get>  (<? cmp) 9999 s) #f)

(equal! (values-first (rb-get<=* cmp 1000 s)) #f)           (equal! (rb-get<= cmp 1000 s) #f)
(equal! (values->list (rb-get<=* cmp 1111 s)) '(#"1111" 0)) (equal! (rb-get<= cmp 1111 s) #"1111")
(equal! (values->list (rb-get<=* cmp 4000 s)) '(#"3333" 2)) (equal! (rb-get<= cmp 4000 s) #"3333")
(equal! (values->list (rb-get<=* cmp 4444 s)) '(#"4444" 3)) (equal! (rb-get<= cmp 4444 s) #"4444")
(equal! (values->list (rb-get<=* cmp 4445 s)) '(#"4444" 3)) (equal! (rb-get<= cmp 4445 s) #"4444")
(equal! (values->list (rb-get<=* cmp 6666 s)) '(#"6666" 5)) (equal! (rb-get<= cmp 6666 s) #"6666")
(equal! (values->list (rb-get<=* cmp 9999 s)) '(#"6666" 5)) (equal! (rb-get<= cmp 9999 s) #"6666")

(equal! (values-first (rb-get<*  (<? cmp) 1000 s)) #f)           (equal! (rb-get<  (<? cmp) 1000 s) #f)
(equal! (values-first (rb-get<*  (<? cmp) 1111 s)) #f)           (equal! (rb-get<  (<? cmp) 1111 s) #f)
(equal! (values->list (rb-get<*  (<? cmp) 4000 s)) '(#"3333" 2)) (equal! (rb-get<  (<? cmp) 4000 s) #"3333")
(equal! (values->list (rb-get<*  (<? cmp) 4444 s)) '(#"3333" 2)) (equal! (rb-get<  (<? cmp) 4444 s) #"3333")
(equal! (values->list (rb-get<*  (<? cmp) 4445 s)) '(#"4444" 3)) (equal! (rb-get<  (<? cmp) 4445 s) #"4444")
(equal! (values->list (rb-get<*  (<? cmp) 6666 s)) '(#"5555" 4)) (equal! (rb-get<  (<? cmp) 6666 s) #"5555")
(equal! (values->list (rb-get<*  (<? cmp) 9999 s)) '(#"6666" 5)) (equal! (rb-get<  (<? cmp) 9999 s) #"6666")

;(get-at-most* cmp 4000 s)
;(get* cmp 3323 s)
;(->sexp s)
;(exit)

(equal! '(1 4 9 64 100 900)
        (rb->list (rb-map (lambda(x)(* x x)) (rb integer-compare 30 3 10 2 8 1))))

(equal! '(1 2 3 4 5 6 8)
        (rb->list (rb-union integer-compare
                            (rb integer-compare 1 2 4 5)
                            (rb integer-compare 2 3 5 6 8))))

(equal! '(1 4)
        (rb->list (rb-substract integer-compare
                                (rb integer-compare 1 2 4 5)
                                (rb integer-compare 2 3 5 6 8))))
(equal! '(3 6 8)
        (rb->list (rb-substract integer-compare
                                (rb integer-compare 2 3 5 6 8)
                                (rb integer-compare 1 2 4 5))))

; TODO: rb -> cpmrange -> (rbi rbi)
;(define (range start end) ; start inclusive, end not
;  (lambda(x) (cond [(bytes<? x start) -1]
;                   [(bytes<? end x) 1]
;                   [else 0])))

;(rb-for-each o s (range #"2000" #"5000"))
;(equal! (iter->list (rb->iter s (range #"2000" #"5000")))
;        '(#"2222" #"3333" #"4444"))

(equal! (iter->list (rb->iter s))
        (reverse (iter->list (rb->iter/backward s)))
        (rb->list s))

;(exit)

;(check s)
(define (test s)
  (define ii 0)
  (rb-for-each (lambda(v) 
                 (equal! (rb-ref s ii) v)
                 ;              (=! ii (values-second (get* bytes-compare v s)))
                 (equal! (list v ii)
                         (values->list (rb-get=* bytes-compare v s))
                         (values->list (rb-get>=* bytes-compare v s))
                         (values->list (rb-get<=* bytes-compare v s)))
                 (inc! ii)
                 ) s))


(define rnd100k (build-vector 10000 (lambda(i)
                                      (number->bytes (random-integer #e1e10))
                                      ) ))
(define seq100k (build-vector 10000 (lambda(i)
                                      (number->bytes (+ 100000000 i))
                                      ) ))
;  (collect-garbage)
;  (sleep 1)
;  (collect-garbage)
;  (sleep 1)

;  (o (vector-fold (lambda(i sum x) (+ sum (bytes->number x))) 0 rnd100k))
(time   (vector-for-each (lambda(i k)
                           (set! s (rb-insert bytes-compare k s))
                           ) rnd100k)  )


;  (dotimes (i 100000) (set! s (insert i s)))
'depth (rb-depth s)
'size (rb-length s)
;(exit)
(o (take (rb->list s) 10))
(begin (rb-check s) (void))
(begin (test s) (void))
'remove
(dotimes (i (* 99/100 (rb-length s)))
         (let* ([sz (rb-length s)] 
                [xx (rb-ref s (random sz))])
           ;(set! s (remove bytes-compare (ref (random sz) s) s))
           ;(equal! (remove bytes-compare xx s)
           ;        (remove2 bytes-compare xx s))
           (define s2 (rb-remove bytes-compare xx s))
           ;(true! (rb-subset? bytes-compare s2 s))
           ;(false! (rb-subset? bytes-compare s s2))
           (set! s s2)
           (=! sz (+ 1 (rb-length s))))
         )
(begin (rb-check s) (void))
(begin (test s) (void))
(dotimes (i (rb-length s))
         (let* ([sz (rb-length s)]
                [xx (rb-ref s (random sz))])
           ;(set! s (remove bytes-compare (ref (random sz) s) s))
           ;(equal! (remove bytes-compare xx s)
           ;        (remove2 bytes-compare xx s))
           (define s2 (rb-remove bytes-compare xx s))
           (true! (rb-subset? bytes-compare s2 s))
           (false! (rb-subset? bytes-compare s s2))
           (set! s s2)
           (=! sz (+ 1 (rb-length s))))
         )

(=! 1 (rb-depth s))
(=! 0 (rb-length s))
(begin (rb-check s) (void))
(begin (test s) (void))

;  (time ((dotimes (i 1000) (set! s (insert i s)))))
;  )
;(get* bytes-compare #"4444" s)
;(get* bytes-compare #"5555" s)
;(->sexp s)
#|
(get bytes-compare #"1052830883" s)
(get bytes-compare #"10528308832" s)

(define s2 (remove bytes-compare #"1052830883" s))
(get bytes-compare #"1052830883" s2)
(o (size s2))
(o (size s2))
; ref: k v n  
; nth: k v
;|#
;|#
;|#